home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.002 / stk-3 / STk-3.1 / Contrib / STk-wtour / lessons / canvas-drag.stk < prev    next >
Encoding:
Text File  |  1995-12-13  |  920 b   |  35 lines
  1. ;;; Moving an object on a canvas
  2. ;;;   (drag the circle around)
  3.  
  4. (define last-x 0)
  5. (define last-y 0)
  6.  
  7. (define (item-start-drag c x y)
  8.   (set! last-x (c 'canvasx x))
  9.   (set! last-y (c 'canvasy y)))
  10.  
  11. (define (item-drag c x y)
  12.   (set! x (c 'canvasx x))
  13.   (set! y (c 'canvasy y))
  14.   (c 'move 'current (- x last-x) (- y last-y))
  15.   (set! last-x x)
  16.   (set! last-y y))
  17.  
  18. (pack (canvas '.c1) :expand #t :fill "both")
  19.  
  20. (.c1 'create 'oval 150 150 170 170 :fill "skyblue" :tag "oval")
  21.  
  22. ;;; Bindings 
  23. (.c1 'bind "oval" "<Any-Enter>"  (lambda ()
  24.                    (.c1 'itemconfig 'current :fill "red")))
  25. (.c1 'bind "oval" "<Any-Leave>"  (lambda ()
  26.                    (.c1 'itemconfig 'current :fill "SkyBlue2")))
  27. (.c1 'bind "oval" "<1>"      (lambda (x y)
  28.                    (item-start-drag .c1 x y)))
  29. (.c1 'bind "oval" "<B1-Motion>"  (lambda (x y)
  30.                    (item-drag .c1 x y)))
  31. (.c1 'bind "oval" "<ButtonRelease-1>" 
  32.                        (lambda ()
  33.                     (.c1 'dtag 'selected)))
  34.  
  35.